1 Preface

2 Code

R functions

library(tidyverse)
#> Warning: package 'tidyverse' was built under R version 4.2.1
#> ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
#> ✔ ggplot2 3.3.6      ✔ purrr   0.3.4 
#> ✔ tibble  3.1.8      ✔ dplyr   1.0.10
#> ✔ tidyr   1.2.1      ✔ stringr 1.4.1 
#> ✔ readr   2.1.2      ✔ forcats 0.5.2
#> Warning: package 'ggplot2' was built under R version 4.2.1
#> Warning: package 'tibble' was built under R version 4.2.1
#> Warning: package 'tidyr' was built under R version 4.2.1
#> Warning: package 'readr' was built under R version 4.2.1
#> Warning: package 'dplyr' was built under R version 4.2.1
#> Warning: package 'stringr' was built under R version 4.2.1
#> Warning: package 'forcats' was built under R version 4.2.1
#> ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
#> ✖ dplyr::filter() masks stats::filter()
#> ✖ dplyr::lag()    masks stats::lag()
# install.packages("plyr")
library(plyr)
#> Warning: package 'plyr' was built under R version 4.2.1
#> ------------------------------------------------------------------------------
#> You have loaded plyr after dplyr - this is likely to cause problems.
#> If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
#> library(plyr); library(dplyr)
#> ------------------------------------------------------------------------------
#> 
#> Attaching package: 'plyr'
#> 
#> The following objects are masked from 'package:dplyr':
#> 
#>     arrange, count, desc, failwith, id, mutate, rename, summarise,
#>     summarize
#> 
#> The following object is masked from 'package:purrr':
#> 
#>     compact
# devtools::install_github("pavlakrotka/NCC@v1.0")
library(NCC)
#> Registered S3 methods overwritten by 'registry':
#>   method               from 
#>   print.registry_field proxy
#>   print.registry_entry proxy
#> Warning: package 'memoise' was built under R version 4.2.1
source("C:/Users/mbofi/Dropbox/CeMSIIS/GitHub/Allocation/case-study/aux_functions.R")

3 Case Study

We illustrate the optimal allocations in platform trials by means of a phase II placebo-controlled trial in primary hypercholesterolemia.

In the original study, \(N=92\) patients were randomised following 1:1:1.

# means
mean_control = 17.3/3.5
mean_arm1 = 66.2/3.5
mean_arm2 = 72.3/3.5

In what follows, we simulated the trial using the estimated mean in the control arm in the original study using three allocation strategies -namely, equal allocation (1:…:1), square root of \(k\) (1:…:\(\sqrt(k)\)), and the proposed optimal allocations-, and according to three different trial designs:

  1. Design with one period only (that is, multi-arm design)
  2. Design with two periods (arm 2 starts later, but arms 1 and 2 finish at the same time)
  3. Design with three periods (arm 2 starts later and finishes after arm 1 does)

For comparative purposes, in this case study, we suppose total sample size of \(N=80\) and smaller effect sizes.

3.1 Design 1: multi-arm design

In this case, we consider a design with one period only. The scheme of the trial over time is:

db1_one = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db1_sqrt = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db1_opt = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")
plot_trial(db1_one$data$treatment) 
Figure: Design 1: multi-arm design.

Figure: Design 1: multi-arm design.

Distribution of sample sizes per arm and periods

# sample sizes
db1_one$ss
#>      [,1] [,2] [,3]
#> [1,]   27    0    0
#> [2,]   27    0    0
#> [3,]   27    0    0
db1_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]   23    0    0
#> [2,]   23    0    0
#> [3,]   33    0    0
db1_opt$ss
#>      [,1] [,2] [,3]
#> [1,]   23    0    0
#> [2,]   23    0    0
#> [3,]   33    0    0

db1_one_ss <- data.frame(arms=c("A1","A2","C"),db1_one$ss, c(sum(db1_one$ss[1,]),sum(db1_one$ss[2,]),sum(db1_one$ss[3,])))
db1_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db1_sqrt$ss, c(sum(db1_sqrt$ss[1,]),sum(db1_sqrt$ss[2,]),sum(db1_sqrt$ss[3,])))
db1_opt_ss <- data.frame(arms=c("A1","A2","C"), db1_opt$ss, c(sum(db1_opt$ss[1,]),sum(db1_opt$ss[2,]),sum(db1_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db1_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 27 0 0 27
A2 27 0 0 27
C 27 0 0 27
knitr::kable(db1_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 23 0 0 23
A2 23 0 0 23
C 33 0 0 33
knitr::kable(db1_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 23 0 0 23
A2 23 0 0 23
C 33 0 0 33

Comparing groups when using 1:1 allocation

res1_one = do.call(rbind.data.frame, models_cc(data = db1_one$data) )
knitr::kable(res1_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 12.68476 10.09121 15.27831 TRUE a1
0 14.86421 12.13642 17.59200 TRUE a2

Comparing groups when using \(\sqrt(k)\)-allocation (and thus optimal allocations)

res1_opt = do.call(rbind.data.frame, models_cc(data = db1_opt$data) )
knitr::kable(res1_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 14.20339 11.65083 16.75596 TRUE a1
0 15.50805 12.83460 18.18151 TRUE a2

3.2 Design 2: two-period design

N = 80
N1 = round(N/4)
N2 = round(N-N1)
c(N1,N2,N-N1-N2)
#> [1] 20 60  0

In this case, we consider a design with two periods. The scheme of the trial over time is:

db2_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db2_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db2_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")
plot_trial(db2_one$data$treatment) 
Figure: Design 2: two-period design.

Figure: Design 2: two-period design.

# sample sizes
db2_one$ss
#>      [,1] [,2] [,3]
#> [1,]    0   20    0
#> [2,]   10   20    0
#> [3,]   10   20    0
db2_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   18    0
#> [2,]   10   18    0
#> [3,]   10   25    0
db2_opt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   24    0
#> [2,]   10   10    0
#> [3,]   10   26    0

db2_one_ss <- data.frame(arms=c("A1","A2","C"),db2_one$ss, c(sum(db2_one$ss[1,]),sum(db2_one$ss[2,]),sum(db2_one$ss[3,])))
db2_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db2_sqrt$ss, c(sum(db2_sqrt$ss[1,]),sum(db2_sqrt$ss[2,]),sum(db2_sqrt$ss[3,])))
db2_opt_ss <- data.frame(arms=c("A1","A2","C"), db2_opt$ss, c(sum(db2_opt$ss[1,]),sum(db2_opt$ss[2,]),sum(db2_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db2_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 20 0 20
A2 10 20 0 30
C 10 20 0 30
knitr::kable(db2_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 18 0 18
A2 10 18 0 28
C 10 25 0 35
knitr::kable(db2_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 24 0 24
A2 10 10 0 20
C 10 26 0 36

Comparing groups when using 1:1 allocation

res2_one = do.call(rbind.data.frame, models_cc(data = db2_one$data) )
knitr::kable(res2_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 14.58389 13.14542 16.02237 TRUE a1
0 17.63898 15.10228 20.17567 TRUE a2

Comparing groups when using \(\sqrt(k)\)-allocation

res2_sqrt = do.call(rbind.data.frame, models_cc(data = db2_sqrt$data) )
knitr::kable(res2_sqrt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 14.74905 13.29103 16.20707 TRUE a1
0 14.27277 12.29935 16.24619 TRUE a2

Comparing groups when using the optimal allocations

res2_opt = do.call(rbind.data.frame, models_cc(data = db2_opt$data) )
knitr::kable(res2_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 14.64472 12.85768 16.43175 TRUE a1
0 17.73338 15.80459 19.66216 TRUE a2

3.3 Design 3: three-period design

Suppose now a design with three periods with \(N_1=31\) and consider two situations for \(N_2\), say \(N_2=N-N_1\) and \(N_2= N_1/2\).

3.3.1 Trial with equal sized periods 1 and 3

Suppose now that the size of the periods are:

N1 = round(N/3)
N2 = round(N-2*N1)
c(N, N1, N2, N-N1-N2)
#> [1] 80 27 26 27

Note that in this case the duration of periods 1 and 3 is the same, leading to a symmetrical trial. Below we illustrate the scheme of the trial over time.


db3_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db3_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db3_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")

plot_trial(db3_opt$data$treatment) 
Design 3: three-period design (r1=r3).

Design 3: three-period design (r1=r3).


# sample sizes
db3_one$ss
#>      [,1] [,2] [,3]
#> [1,]    0    9   13
#> [2,]   14    9    0
#> [3,]   14    9   13
db3_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]    0    8   13
#> [2,]   14    8    0
#> [3,]   14   11   13
db3_opt$ss
#>      [,1] [,2] [,3]
#> [1,]    0    8   13
#> [2,]   14    8    0
#> [3,]   14   11   13

db3_one_ss <- data.frame(arms=c("A1","A2","C"),db3_one$ss, c(sum(db3_one$ss[1,]),sum(db3_one$ss[2,]),sum(db3_one$ss[3,])))
db3_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db3_sqrt$ss, c(sum(db3_sqrt$ss[1,]),sum(db3_sqrt$ss[2,]),sum(db3_sqrt$ss[3,])))
db3_opt_ss <- data.frame(arms=c("A1","A2","C"), db3_opt$ss, c(sum(db3_opt$ss[1,]),sum(db3_opt$ss[2,]),sum(db3_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db3_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 9 13 22
A2 14 9 0 23
C 14 9 13 36
knitr::kable(db3_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 8 13 21
A2 14 8 0 22
C 14 11 13 38
knitr::kable(db3_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 8 13 21
A2 14 8 0 22
C 14 11 13 38

Comparing groups when using 1:1 allocation

res3_one = do.call(rbind.data.frame, models_cc(data = db3_one$data) )
knitr::kable(res3_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 13.44103 12.30840 14.57366 TRUE a1
0 15.43635 14.16838 16.70432 TRUE a2

Comparing groups when using \(\sqrt(k)\)-allocation

res3_sqrt = do.call(rbind.data.frame, models_cc(data = db3_sqrt$data) )
knitr::kable(res3_sqrt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 13.51276 12.37502 14.65051 TRUE a1
0 15.96106 14.96704 16.95508 TRUE a2

Comparing groups when using the optimal allocations

res3_opt = do.call(rbind.data.frame, models_cc(data = db3_opt$data) )
knitr::kable(res3_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 14.69724 13.46913 15.92535 TRUE a1
0 15.05351 13.79869 16.30833 TRUE a2

3.3.2 Trial with unequal size for periods 1 and 3

Suppose now that the size of the periods are:

# N = 80
N1 = round(N/3)
N2 = round(2*(N-N1)/3)
c(N1,N2,N-N1-N2) 
#> [1] 27 35 18
db3_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db3_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db3_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")

plot_trial(db3_opt$data$treatment) 
Design 3: three-period design (r1<r3).

Design 3: three-period design (r1<r3).


# sample sizes
db3_one$ss
#>      [,1] [,2] [,3]
#> [1,]    0   12    9
#> [2,]   14   12    0
#> [3,]   14   12    9
db3_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   10    9
#> [2,]   14   10    0
#> [3,]   14   14    9
db3_opt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   13    9
#> [2,]   14    7    0
#> [3,]   14   15    9

db3_one_ss <- data.frame(arms=c("A1","A2","C"),db3_one$ss, c(sum(db3_one$ss[1,]),sum(db3_one$ss[2,]),sum(db3_one$ss[3,])))
db3_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db3_sqrt$ss, c(sum(db3_sqrt$ss[1,]),sum(db3_sqrt$ss[2,]),sum(db3_sqrt$ss[3,])))
db3_opt_ss <- data.frame(arms=c("A1","A2","C"), db3_opt$ss, c(sum(db3_opt$ss[1,]),sum(db3_opt$ss[2,]),sum(db3_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db3_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 12 9 21
A2 14 12 0 26
C 14 12 9 35
knitr::kable(db3_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 10 9 19
A2 14 10 0 24
C 14 14 9 37
knitr::kable(db3_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 13 9 22
A2 14 7 0 21
C 14 15 9 38

Comparing groups when using 1:1 allocation

res3_one = do.call(rbind.data.frame, models_cc(data = db3_one$data) )
knitr::kable(res3_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 15.26003 14.21148 16.30857 TRUE a1
0 15.87749 14.71328 17.04171 TRUE a2

Comparing groups when using \(\sqrt(k)\)-allocation

res3_sqrt = do.call(rbind.data.frame, models_cc(data = db3_sqrt$data) )
knitr::kable(res3_sqrt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 14.89944 13.84920 15.94967 TRUE a1
0 16.23051 15.12429 17.33672 TRUE a2

Comparing groups when using the optimal allocations

res3_opt = do.call(rbind.data.frame, models_cc(data = db3_opt$data) )
knitr::kable(res3_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 13.98791 12.78190 15.19392 TRUE a1
0 15.97735 14.67709 17.27760 TRUE a2

4 Simulations

load("C:/Users/mbofi/Dropbox/CeMSIIS/GitHub/Allocation/case-study/results/simstudy_results.RData")
df_res$design = ifelse(as.numeric(df_res$r1)+as.numeric(df_res$r2)==1,"2-period", "3-period")

To compare power and type 1 error of the different designs, we undertake a simulation study to evaluate the performance when using 1:1 allocations. For comparative purposes, we also consider a total sample size for the trial equal to XX

res_report_H1 <- df_res %>% filter(H0=="FALSE") %>% select(minrt,rt_a1,rt_a2,r1,r2,alloc,design)
knitr::kable(res_report_H1, format = "markdown", caption = c("Power comparisons"), col.names=c("Min Power", "Power A1", "Power A2", "r1",   "r2",   "Allocation",   "Design"))
Power comparisons
Min Power Power A1 Power A2 r1 r2 Allocation Design
0.90015 0.93188 0.90015 0.3375 0.4375 one 3-period
0.91773 0.91773 0.92704 0.3375 0.4375 opt 3-period
0.91739 0.94009 0.91739 0.3375 0.4375 sqrt 3-period
0.40323 0.71062 0.40323 0.25 0.75 one 2-period
0.48907 0.6354 0.48907 0.25 0.75 opt 2-period
0.40952 0.70559 0.40952 0.25 0.75 sqrt 2-period
res_report_H0 <- df_res %>% filter(H0=="TRUE") %>% select(minrt,rt_a1,rt_a2,r1,r2,alloc,design)
knitr::kable(res_report_H0, format = "markdown", caption = c("Type 1 error rate"), col.names=c("Min T1E", "T1E A1", "T1E A2",   "r1",   "r2",   "Allocation",   "Design"))
Type 1 error rate
Min T1E T1E A1 T1E A2 r1 r2 Allocation Design
0.0252 0.0252 0.02542 0.3375 0.4375 one 3-period
0.0245 0.02456 0.0245 0.3375 0.4375 opt 3-period
0.02396 0.02483 0.02396 0.3375 0.4375 sqrt 3-period
0.02464 0.02464 0.02515 0.25 0.75 one 2-period
0.02139 0.02139 0.02433 0.25 0.75 opt 2-period
0.02425 0.02425 0.02471 0.25 0.75 sqrt 2-period
 

Center for Medical Statistics, Informatics and Intelligent Systems, Medical University of Vienna.

[Klassifizierung: vertraulich]

Marta Bofill Roig

marta.bofillroig@meduniwien.ac.at

and Martin Posch

martin.posch@meduniwien.ac.at